home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 25 / Cream of the Crop 25.iso / comm / yep16.zip / YEP16SRC.ZIP / TM_STRGS.PAS < prev    next >
Pascal/Delphi Source File  |  1997-01-09  |  7KB  |  246 lines
  1. unit Tm_Strgs;
  2.  
  3. interface
  4.  
  5. Function StrPosC(s,t : pchar) : Longint; {index of string in substring, 1 based}
  6. Function StrIPos(s,t : pchar) : pchar;
  7. Function StrIPosC(s,t : pchar) : longint;
  8. PROCEDURE StrLInsert(s,i : pchar; pos, MaxStrLen : longint);
  9. Procedure StrDelete(s : pchar; pos, count : longint); {?}
  10. Function  StrSubstStr(s, target, rep : pchar; MaxL : longint; cs : boolean) : pchar;
  11.           {substitute target with rep in s, with case sensitivity}
  12. Function LoChar(Ch : Char) : Char;
  13. Function UpChar(Ch : Char) : Char;
  14. Function StrQuoted(p : pchar; ql,qr : char) : pchar;
  15. Function StrReplace(var cur : pchar; newpchar : pchar) : pchar;
  16. procedure StrAppend(var p: pchar; a : pchar);
  17.  
  18. Function  Ltrim(s : pchar; c : char) : pchar;
  19. Function  Rtrim(s : pchar; c : char) : pchar;
  20.  
  21. Function Str2Pchar(var s : string) : pchar;
  22. Function MakeStrNew(s : string) : pchar;
  23.  
  24.  
  25. implementation
  26. uses strings;
  27.  
  28. {
  29. procedure  StrLcat(s1, s2 : pchar; MaxL : longint);
  30. var P : pointer;
  31. begin
  32.      Strmove(strEnd(s1),s2,strLen(s2)+1);
  33. end;
  34. }
  35.  
  36. Function LoChar(Ch : Char) : Char;
  37. begin
  38.   If Ord(Ch) In [65..90] Then Ch := Chr(Ord(Ch) + 32)
  39.   Else If Ord(Ch) > 122 Then
  40.     If Ch='Æ' Then Ch := ' '
  41.     Else If Ch='¥' Then Ch:='¢' Else If Ch='Å' Then Ch:='å'
  42.     Else If Ch='Ä' Then Ch:='ä' Else If Ch='Ç' Then Ch:='ç'
  43.     Else If Ch='É' Then Ch:='é' Else If Ch='Ö' Then Ch:='ö'
  44.     Else If Ch='Ñ' Then Ch:='ñ' Else If Ch='Ü' Then Ch:='ü';
  45.   LoChar := Ch;
  46. end;
  47.  
  48. Function UpChar(Ch : Char) : Char;
  49. begin
  50.   If Ord(Ch) In [97..122] Then Ch := Chr(Ord(Ch) - 32)
  51.   Else If Ord(Ch) > 90 Then
  52.     If Ch='' Then Ch:='Æ'
  53.     Else If Ch='¢' Then Ch:='¥' Else If Ch='å' Then Ch:='Å'
  54.     Else If Ch='ä' Then Ch:='Ä' Else If Ch='ç' Then Ch:='Ç'
  55.     Else If Ch='é' Then Ch:='É' Else If Ch='ö' Then Ch:='Ö'
  56.     Else If Ch='ñ' Then Ch:='Ñ' Else If Ch='ü' Then Ch:='Ü';
  57.   UpChar:=Ch;
  58. end;
  59.  
  60. Function StrPosC(s,t : pchar) : Longint;
  61. var ps : pchar;
  62. begin
  63.      ps:=StrPos(s,t);
  64.      if ps=nil then StrPosC:=0
  65.      else StrPosC:=succ(longint(s))-longint(t);
  66. end;
  67.  
  68. Function StrIPos(s,t : pchar) : pchar;
  69. var
  70.    ps,pt : pchar;
  71. begin
  72.      StrIPos:=nil;
  73.      if (s=nil)or(t=nil)or(s^=#0)or(t^=#0) then exit;
  74.      while (s^<>#0) do begin
  75.            pt:=t; ps:=s;
  76.            while (pt^<>#0)and((upchar(pt^)=ps^)or(loChar(pt^)=ps^)) do begin
  77.                  inc(pt);inc(ps);
  78.            end;
  79.            if pt^=#0 then begin StrIPos:=s; break; end;
  80.            inc(s);
  81.      end;
  82. end;
  83.  
  84. Function StrIPosC(s,t : pchar) : longint;
  85. var p : pchar;
  86. begin
  87.      p:=StrIPos(s,t);
  88.      if p=nil then StrIPosC:=0
  89.      else StrIPosC:=succ(longint(p))-longint(s);
  90. End;
  91.  
  92. Function Str2Pchar(var s : string) : pchar;
  93. var l : byte;
  94. begin
  95.      l:=byte(s[0]);
  96.      if l>0 then begin
  97.         move(s[1],s[0],l);
  98.         s[l]:=#0;
  99.         Str2Pchar:=@s;
  100.      end else Str2Pchar:=Nil;
  101. end;
  102.  
  103. Function MakeStrNew(s : string) : pchar;
  104. var p : pchar;
  105. begin
  106.      p:=Str2Pchar(s);
  107.      MakeStrNew:=StrNew(p);
  108. end;
  109.  
  110.  
  111. Procedure StrLInsert(s,i : pchar; pos, MaxStrLen : longint);
  112. var
  113.    p : pchar;
  114.    l : longint;
  115. begin
  116.      if (Pos<MaxStrLen)and(pos>0) then begin  { don't insert past end of buffer}
  117.         l:=StrLen(s);
  118.         if pos>l then StrLCat(s,i,MaxStrLen)
  119.         else begin
  120.              p := StrNew(s+pred(pos));
  121.              (s+pred(pos))^:=#0;
  122.              StrLCat(s,i,MaxStrLen);
  123.              StrLCat(s,p,MaxStrLen);
  124.              StrDispose(p);
  125.         end;
  126.      end;
  127. end;
  128.  
  129. Procedure StrDelete(s : pchar; pos, count : longint); {?}
  130. var Len : longint;
  131.     pSource,pDest : POINTER;
  132. begin
  133.      Len:=StrLen(s);
  134.      if (Pos<=Len)and(pos>0) then begin  { don't insert past end of buffer}
  135.         if (pred(pos)+count)>=Len then (s+pred(pos))^:=#0
  136.         else begin
  137.              pSource:=s+pred(pos)+count; pDest:=s+pred(pos);
  138.              StrCopy(pDest,pSource);
  139.         end;
  140.      end;
  141. end;
  142.  
  143. Function StrDDelete(s : pchar; pos, count : longint) : pchar; {?}
  144. var Len : longint;
  145.     p   : pchar;
  146. begin
  147.      Len:=succ(StrLen(s));
  148.      GetMem(p,Len);
  149.      StrCopy(p,s);
  150.      StrDelete(p,pos,count);
  151.      StrDDelete:=StrNew(p);
  152.      strDispose(s);
  153.      FreeMem(p,len);
  154. end;
  155.  
  156. Function  StrSubstStr(s, target, rep : pchar; MaxL : longint; cs : boolean) : pchar;
  157.           {substitute target with rep in s, with case sensitivity}
  158. var x : longint;
  159.     l : longint;
  160.     ps : pchar;
  161.     len : longint;
  162. begin
  163.      StrSubstStr:=s;
  164.      ps:=nil;
  165.      if (s=nil)or(target=nil)or(rep=nil)or(rep^=#0)or(target^=#0) then exit;
  166.      if CS then x:=StrPosC(s,target) else x:=StrIPosC(s,target);
  167.      if x>0 then begin
  168.           ps:=StrNew((s+(x-1)+StrLen(target)));
  169.           (s+x-1)^:=#0;
  170.           {StrLcat(s,rep,MaxL);}
  171.           StrLcopy(strEnd(s),rep,MaxL-strLen(s));
  172.           if ps<>nil then StrLCat(s,ps,MaxL);
  173.           StrDispose(ps);
  174.      end;
  175. end;
  176.  
  177. Function StrQuoted(p : pchar; ql,qr : char) : pchar;
  178. var q1,q2 : pchar;
  179.     x : longint;
  180. begin
  181.      StrQuoted:=nil;
  182.      q1:=StrScan(p,ql);                     {left quote char}
  183.      if q1<>nil then begin
  184.         inc(q1);                            {one past left quote}
  185.         q2:=StrRScan(p,qr);                 {right quote char}
  186.         if (q2<>nil)and(q2>q1) then begin
  187.            q2^:=#0;                         {temp set end of string}
  188.            StrQuoted:=StrNew(q1);           {make new string}
  189.            q2^:=qr;                         {put back right quote char}
  190.         end;
  191.      end;
  192. end;
  193.  
  194. Function  Ltrim(s : pchar; c : char) : pchar;
  195. begin
  196.      if s<>nil then begin
  197.         while (s^=c)and(s^<>#0) do inc(s);
  198.      end;
  199.      Ltrim:=s;
  200. end;
  201.  
  202. Function  Rtrim(s : pchar; c : char) : pchar;
  203. var e : pchar;
  204. begin
  205.      e := StrEnd(s);
  206.      dec(e);
  207.      if e<>s then begin
  208.         while (e^=c)and(s^<>#0) do dec(e);
  209.      end;
  210.      if e^=c then e^:=#0 else (e+1)^:=#0;
  211.      Rtrim:=s;
  212. end;
  213.  
  214. procedure StrAppend(var p: pchar; a : pchar);
  215. var
  216.    t : pchar;
  217. begin
  218.      if a=nil then exit;
  219.      if (p=nil) then begin
  220.         if (a=nil) then exit
  221.         else p:=StrNew(a);
  222.      end
  223.      else begin
  224.           getMem(t,Strlen(p)+strLen(a)+1);
  225.           if t<>nil then begin
  226.              StrCopy(t,p);
  227.              StrCat(t,a);
  228.              StrDispose(p);
  229.              p:=t;
  230.           end;
  231.      end;
  232. end;
  233.  
  234. Function StrReplace(var cur : pchar; newpchar : pchar) : pchar;
  235. begin
  236.      strDispose(cur);
  237.      cur := newpchar;
  238.      StrReplace := newpchar;
  239. end;
  240.  
  241. Begin
  242. End.
  243.  
  244.  
  245.  
  246.